home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HAM Radio 1997
/
HAM Radio 1997.iso
/
vcls
/
lexscan
/
evalexpr.pas
next >
Wrap
Pascal/Delphi Source File
|
1996-04-08
|
10KB
|
290 lines
========
Newsgroups: comp.lang.pascal.delphi.components
Subject: Lexical Scanner [1/4]
From: jbui@scd.hp.com (Joseph Bui)
Date: 27 Jul 1995 16:58:14 GMT
{************** EVALEXPR.PAS *******************}
unit Evalexpr;
interface
uses
TypInfo, Classes, SysUtils, Lexscan, StrUtils;
type
ESyntaxError = class(Exception);
function Simplify(const Expression: string): string;
implementation
{**************************************************************}
function Simplify(const Expression: string): string;
{************************* Constants **************************}
const
{
Tokens are used when loading the value table. These should be
variables, fields or typed constants if possible.
}
NotToken = #33;
AndToken = #38;
MulToken = #42;
AddToken = #43;
SubToken = #45;
DivToken = #47;
LtToken = #60;
EqToken = #61;
GtToken = #62;
PowToken = #94;
OrToken = #124;
{
Chars are used when doing calculations. #0...#241 are
value table indexes. #242...#255 are operators.
}
FalseStr = '0';
TrueStr = '1';
NotChar = #242;
MulChar = #243;
DivChar = #244;
PowChar = #245;
AndChar = #246;
AddChar = #247;
SubChar = #248;
OrChar = #249;
EqChar = #250;
NeqChar = #251;
LtChar = #252;
GtChar = #253;
LteChar = #254;
GteChar = #255;
{************************* Variables **************************}
var
ValueTable: TStringList;
AStream: TMemoryStream;
AScanner: TStreamScanner;
Operator: byte;
Token2Char: char;
IndexL, IndexR: integer;
{************************* TypeOf ***************************}
function TypeOf(const Index: integer): TTypeKind;
begin
if IsAnInt(ValueTable[Index]) then
Result:=tkInteger
else
if IsAFloat(ValueTable[Index]) then
Result:=tkFloat
else
Result:=tkString;
end;
{************************* Simplify ***************************}
begin
try
ValueTable:=TStringList.Create;
AStream:=TMemoryStream.Create;
AStream.Write((@Expression[1])^, Length(Expression));
AScanner:=TStreamScanner.Create(AStream);
Result:=Null;
{************** Load ValueTable and Result ****************}
with AScanner do
repeat
case Token of
StringToken : Token2Char:=Chr(ValueTable.Add(TokenString));
IntegerToken, FloatToken :
if (Result[Length(Result)] < NotChar) and (Length(Result) > 0) then
begin
if TokenString[1] in [AddToken, SubToken] then
begin
if TokenString[1] = AddToken then
AppendStr(Result, AddChar)
else
AppendStr(Result, SubChar);
Token2Char:=Chr(ValueTable.Add(Copy(TokenString, 2, 255)));
end
else
raise ESyntaxError.Create('Expected operator');
end
else
Token2Char:=Chr(ValueTable.Add(TokenString));
NotToken : Token2Char:=NotChar;
else
if Result[Length(Result)] >= NotChar then
raise ESyntaxError.Create('Expected value or variable')
else
case Token of
AndToken : Token2Char:=AndChar;
MulToken : Token2Char:=MulChar;
AddToken : Token2Char:=AddChar;
SubToken : Token2Char:=SubChar;
DivToken : Token2Char:=DivChar;
LtToken :
case NextToken of
EqToken : Token2Char:=LteChar;
GtToken : Token2Char:=NeqChar;
else
begin
Token2Char:=LtChar;
LastToken;
end;
end;
EqToken :
if NextToken = EqToken then
Token2Char:=EqChar
else
raise ESyntaxError.Create('Invalid assignment');
GtToken :
if NextToken = EqToken then
Token2Char:=GteChar
else
begin
Token2Char:=GtChar;
LastToken;
end;
PowToken : Token2Char:=PowChar;
OrToken : Token2Char:=OrChar;
else
raise ESyntaxError.Create('Unknown operator');
end; {case Token of}
end; {case Token of}
AppendStr(Result, Token2Char);
NextToken;
until Token = EofToken;
{************************* Not ****************************}
repeat
Operator:=Pos(NotChar, Result);
if Operator = Length(Result) then
raise ESyntaxError.Create('Expected value or variable');
if Operator > 0 then
begin
IndexR:=Ord(Result[Operator + 1]);
if (TypeOf(IndexR) = tkInteger) and
(StrToInt(ValueTable[IndexR]) <> 0) then
ValueTable[IndexR]:=FalseStr
else
ValueTable[IndexR]:=TrueStr;
Delete(Result, Operator, 1);
end;
until Operator = 0;
{******************** Mul Div Pow And *********************}
repeat
Operator:=SetPos(Result, [MulChar, DivChar, PowChar, AndChar]);
if Operator = Length(Result) then
raise ESyntaxError.Create('Expected value or variable');
if Operator > 0 then
begin
IndexL:=Ord(Result[Operator - 1]);
IndexR:=Ord(Result[Operator + 1]);
case Result[Operator] of
MulChar : ValueTable[IndexL]:=FloatToStr(
StrToNum(ValueTable[IndexL]) *
StrToNum(ValueTable[IndexR]));
DivChar : ValueTable[IndexL]:=FloatToStr(
StrToNum(ValueTable[IndexL]) /
StrToNum(ValueTable[IndexR]));
PowChar : ValueTable[IndexL]:=FloatToStr(Exp(
Ln(StrToNum(ValueTable[IndexL])) *
StrToNum(ValueTable[IndexR])));
AndChar : ValueTable[IndexL]:=IntToStr(
StrToInt(ValueTable[IndexL]) and
StrToInt(ValueTable[IndexR]));
end;
Delete(Result, Operator, 2);
end;
until Operator = 0;
{*********************** Add Sub Or ***********************}
repeat
Operator:=SetPos(Result, [AddChar, SubChar, OrChar]);
if Operator = Length(Result) then
raise ESyntaxError.Create('Expected value or variable');
if Operator > 0 then
begin
IndexL:=Ord(Result[Operator - 1]);
IndexR:=Ord(Result[Operator + 1]);
case Result[Operator] of
AddChar :
if (TypeOf(IndexL) = tkString) or (TypeOf(IndexR) = tkString) then
ValueTable[IndexL]:=ValueTable[IndexL] + ValueTable[IndexR]
else
ValueTable[IndexL]:=FloatToStr(
StrToNum(ValueTable[IndexL]) +
StrToNum(ValueTable[IndexR]));
SubChar : ValueTable[IndexL]:=FloatToStr(
StrToNum(ValueTable[IndexL]) -
StrToNum(ValueTable[IndexR]));
OrChar : ValueTable[IndexL]:=IntToStr(
StrToInt(ValueTable[IndexL]) or
StrToInt(ValueTable[IndexR]));
end;
Delete(Result, Operator, 2);
end;
until Operator = 0;
{****************** Eq Neq Lt Gt Lte Gte ******************}
repeat
Operator:=SetPos(Result,
[EqChar, NeqChar, LtChar, GtChar, LteChar, GteChar]);
if Operator = Length(Result) then
raise ESyntaxError.Create('Expected value or variable');
if Operator > 0 then
begin
IndexL:=Ord(Result[Operator - 1]);
IndexR:=Ord(Result[Operator + 1]);
if (TypeOf(IndexL) = tkString) or (TypeOf(IndexR) = tkString) then
case Result[Operator] of
EqChar : ValueTable[IndexL]:=IntToStr(byte(
CompareStr(ValueTable[IndexL], ValueTable[IndexR]) = 0));
NeqChar : ValueTable[IndexL]:=IntToStr(byte(
CompareStr(ValueTable[IndexL], ValueTable[IndexR]) <> 0));
LtChar : ValueTable[IndexL]:=IntToStr(byte(
CompareStr(ValueTable[IndexL], ValueTable[IndexR]) < 0));
GtChar : ValueTable[IndexL]:=IntToStr(byte(
CompareStr(ValueTable[IndexL], ValueTable[IndexR]) > 0));
LteChar : ValueTable[IndexL]:=IntToStr(byte(
CompareStr(ValueTable[IndexL], ValueTable[IndexR]) <= 0));
GteChar : ValueTable[IndexL]:=IntToStr(byte(
CompareStr(ValueTable[IndexL], ValueTable[IndexR]) >= 0));
end
else
case Result[Operator] of
EqChar : ValueTable[IndexL]:=IntToStr(byte(
StrToNum(ValueTable[IndexL]) = StrToNum(ValueTable[IndexR])));
NeqChar : ValueTable[IndexL]:=IntToStr(byte(
StrToNum(ValueTable[IndexL]) <> StrToNum(ValueTable[IndexR])));
LtChar : ValueTable[IndexL]:=IntToStr(byte(
StrToNum(ValueTable[IndexL]) < StrToNum(ValueTable[IndexR])));
GtChar : ValueTable[IndexL]:=IntToStr(byte(
StrToNum(ValueTable[IndexL]) > StrToNum(ValueTable[IndexR])));
LteChar : ValueTable[IndexL]:=IntToStr(byte(
StrToNum(ValueTable[IndexL]) <= StrToNum(ValueTable[IndexR])));
GteChar : ValueTable[IndexL]:=IntToStr(byte(
StrToNum(ValueTable[IndexL]) >= StrToNum(ValueTable[IndexR])));
end;
Delete(Result, Operator, 2);
end;
until Operator = 0;
{**************** Load Result from ValueTabl **************}
IndexL:=Length(Result);
for Operator:=1 to IndexL do
AppendStr(Result, ValueTable[Ord(Result[Operator])]);
Result:=Copy(Result, IndexL + 1, 255);
{********************** Free Objects ************************}
finally
ValueTable.Free;
AScanner.Free;
AStream.Free;
end;
end;
end.